home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch8 / Stocks2b.frm (.txt) < prev    next >
Visual Basic Form  |  1999-05-28  |  7KB  |  202 lines
  1. VERSION 5.00
  2. Begin VB.Form frmStocks2b 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Stocks2b"
  5.    ClientHeight    =   4140
  6.    ClientLeft      =   1305
  7.    ClientTop       =   810
  8.    ClientWidth     =   6870
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    PaletteMode     =   1  'UseZOrder
  13.    ScaleHeight     =   276
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   458
  16.    Begin VB.TextBox txtFramesPerSecond 
  17.       Height          =   285
  18.       Left            =   1440
  19.       TabIndex        =   4
  20.       Text            =   "20"
  21.       Top             =   3840
  22.       Width           =   375
  23.    End
  24.    Begin VB.TextBox txtNumStocks 
  25.       Height          =   285
  26.       Left            =   1440
  27.       TabIndex        =   3
  28.       Text            =   "5"
  29.       Top             =   3480
  30.       Width           =   375
  31.    End
  32.    Begin VB.CommandButton cmdStart 
  33.       Caption         =   "Start"
  34.       Default         =   -1  'True
  35.       Height          =   495
  36.       Left            =   2160
  37.       TabIndex        =   1
  38.       Top             =   3540
  39.       Width           =   855
  40.    End
  41.    Begin VB.PictureBox picCourt 
  42.       AutoRedraw      =   -1  'True
  43.       Height          =   3375
  44.       Left            =   0
  45.       ScaleHeight     =   221
  46.       ScaleMode       =   3  'Pixel
  47.       ScaleWidth      =   453
  48.       TabIndex        =   0
  49.       Top             =   0
  50.       Width           =   6855
  51.    End
  52.    Begin VB.Label Label1 
  53.       Caption         =   "Frames per second:"
  54.       Height          =   255
  55.       Index           =   0
  56.       Left            =   0
  57.       TabIndex        =   5
  58.       Top             =   3840
  59.       Width           =   1455
  60.    End
  61.    Begin VB.Label Label1 
  62.       Caption         =   "Number of stocks:"
  63.       Height          =   255
  64.       Index           =   1
  65.       Left            =   0
  66.       TabIndex        =   2
  67.       Top             =   3480
  68.       Width           =   1455
  69.    End
  70. Attribute VB_Name = "frmStocks2b"
  71. Attribute VB_GlobalNameSpace = False
  72. Attribute VB_Creatable = False
  73. Attribute VB_PredeclaredId = True
  74. Attribute VB_Exposed = False
  75. Option Explicit
  76. Private NumStocks As Integer
  77. Private StockValue() As Integer
  78. Private StockTrend() As Integer
  79. Private CourtWid As Single
  80. Private CourtHgt As Single
  81. Private BigValue As Single
  82. Private SmallValue As Single
  83. Private Playing As Boolean
  84. Private NumPlayed As Long
  85. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  86. ' Generate some random data.
  87. Private Sub InitData()
  88. Dim stock As Integer
  89.     ' See how many stocks there should be.
  90.     If Not IsNumeric(txtNumStocks.Text) Then _
  91.         txtNumStocks.Text = "10"
  92.     NumStocks = CInt(txtNumStocks.Text)
  93.     ReDim StockValue(1 To NumStocks)
  94.     ReDim StockTrend(1 To NumStocks)
  95.     ' Set the initial stock data.
  96.     For stock = 1 To NumStocks
  97.         StockValue(stock) = Int(CourtHgt * 0.3 + Rnd * CourtHgt * 0.4)
  98.         StockTrend(stock) = Int(Rnd * 6 - 3)
  99.     Next stock
  100. End Sub
  101. ' Return a new stock value for this stock.
  102. Private Function NewStockValue(ByVal stock_number As Integer) As Integer
  103. Dim new_value As Integer
  104.     ' Set the new value.
  105.     new_value = StockValue(stock_number) + StockTrend(stock_number)
  106.     ' Update the trend value.
  107.     If new_value > BigValue Then
  108.         StockTrend(stock_number) = StockTrend(stock_number) + Int(Rnd * 5 - 3)
  109.     ElseIf new_value < SmallValue Then
  110.         StockTrend(stock_number) = StockTrend(stock_number) + Int(Rnd * 5 - 1)
  111.     Else
  112.         StockTrend(stock_number) = StockTrend(stock_number) + Int(Rnd * 5 - 2)
  113.     End If
  114.     ' Keep the trend under control.
  115.     If StockTrend(stock_number) > 10 Then StockTrend(stock_number) = 10
  116.     If StockTrend(stock_number) < -10 Then StockTrend(stock_number) = -10
  117.     NewStockValue = new_value
  118. End Function
  119. ' Start the animation.
  120. Private Sub cmdStart_Click()
  121.     If Playing Then
  122.         Playing = False
  123.         cmdStart.Caption = "Stopped"
  124.         cmdStart.Enabled = False
  125.     Else
  126.         cmdStart.Caption = "Stop"
  127.         Playing = True
  128.         InitData
  129.         PlayData
  130.         Playing = False
  131.         cmdStart.Caption = "Start"
  132.         cmdStart.Enabled = True
  133.     End If
  134. End Sub
  135. ' Play the animation.
  136. Private Sub PlayData()
  137. Dim ms_per_frame As Long
  138. Dim start_time As Single
  139. Dim stop_time As Single
  140.     ' See how fast we should go.
  141.     If Not IsNumeric(txtFramesPerSecond.Text) Then _
  142.         txtFramesPerSecond.Text = "10"
  143.     ms_per_frame = 1000 \ CLng(txtFramesPerSecond.Text)
  144.     ' Clear the drawing area.
  145.     picCourt.Line (0, 0)-(CourtWid, CourtHgt), picCourt.BackColor, BF
  146.     picCourt.Picture = picCourt.Image
  147.     ' Start the animation.
  148.     NumPlayed = 0
  149.     start_time = Timer
  150.     PlayImages ms_per_frame
  151.     ' Display results.
  152.     stop_time = Timer
  153.     MsgBox "Displayed" & Str$(NumPlayed) & _
  154.         " frames in " & _
  155.         Format$(stop_time - start_time, "0.00") & _
  156.         " seconds (" & _
  157.         Format$(NumPlayed / (stop_time - start_time), "0.00") & _
  158.         " FPS)."
  159. End Sub
  160. ' Play the animation.
  161. Private Sub PlayImages(ByVal ms_per_frame As Long)
  162. Dim stock As Integer
  163. Dim next_time As Long
  164. Dim new_value As Integer
  165.     ' Get the current time.
  166.     next_time = GetTickCount()
  167.     ' Start the animation.
  168.     Do While Playing
  169.         NumPlayed = NumPlayed + 1
  170.         ' Move the background 5 pixels left.
  171.         BitBlt picCourt.hDC, _
  172.             0, 0, CourtWid - 5, CourtHgt, _
  173.             picCourt.hDC, 5, 0, vbSrcCopy
  174.         ' Clear the area for the new data.
  175.         picCourt.Line (CourtWid - 5, 0)-Step(5, CourtHgt), picCourt.BackColor, BF
  176.         ' Draw the new stock data.
  177.         For stock = 1 To NumStocks
  178.             ' Get the stock's new value.
  179.             new_value = NewStockValue(stock)
  180.             ' Draw the new segment.
  181.             picCourt.Line (CourtWid - 5, StockValue(stock))-(CourtWid, new_value), QBColor(stock Mod 15)
  182.             ' Update the saved data.
  183.             StockValue(stock) = new_value
  184.         Next stock
  185.         picCourt.Picture = picCourt.Image
  186.         ' Wait until it's time for the next frame.
  187.         next_time = next_time + ms_per_frame
  188.         WaitTill next_time
  189.         If Not Playing Then Exit Do
  190.     Loop
  191. End Sub
  192. Private Sub Form_Load()
  193.     Randomize
  194.     ' Get the drawing area size.
  195.     CourtWid = picCourt.ScaleWidth
  196.     CourtHgt = picCourt.ScaleHeight
  197.     BigValue = CourtHgt * 0.7
  198.     SmallValue = CourtHgt * 0.3
  199.     ' Make a permanent background image.
  200.     picCourt.Picture = picCourt.Image
  201. End Sub
  202.